packages = c('readxl', 'datawizard', 'crosstalk', 'tidyr', 'lubridate','tidyverse', 'plotly', 'd3scatter')
for(p in packages){
if(!require(p,character.only = T)){
install.packages(p)
}
library(p,character.only = T)
}1 The task
In this take-home exercise, you are required to uncover the impact of COVID-19 as well as the global economic and political dynamic in 2022 on Singapore bi-lateral trade (i.e. Import, Export and Trade Balance) by using appropriate analytical visualisation techniques learned in Lesson 6: It’s About Time. Students are encouraged to apply appropriate interactive techniques to enhance user and data discovery experiences.
The write-up of the take-home exercise should include but not limited to the followings:
- Describe the selection and designed consideration of the analytical data visualisation used. The discussion should limit to not more than 150 words each.
- A reproducible description of the procedures used to prepare the analytical visualisation. Please refer to the peer submission I shared.
- A write-up of not more than 100 words to discuss the patterns reveal by each analytical visualization prepared.
Packages
2 Data
Merchandise Trade provided by Department of Statistics, Singapore (DOS) is used. The study period is between January 2020 to December 2022.
Checking the number of sheets it contains
excel_sheets("data/data.xlsx")[1] "Content" "T1" "T2"
Importing data
In the code chunk below, read_xlsx() of readxl package is used to import the data worksheet of our data workbook into R.
T1 <- read_xlsx("data/data.xlsx", sheet = "T1")
T2 <- read_xlsx("data/data.xlsx", sheet = "T2")Formatting data
# Transpose the fat table to long table
T1 <- gather(T1, "MonthYear", "ImportValue", -`Data Series`)
T2 <- gather(T2, "MonthYear", "ExportValue", -`Data Series`)ymd_hms() and hour() are from lubridate package
# Convert MonthYear column to date format
T1$`MonthYear` <- ym(T1$`MonthYear`)
T2$`MonthYear` <- ym(T2$`MonthYear`)
# Convert ImportValue column to numeric format
T1$`ImportValue` <- as.numeric(T1$`ImportValue`)
T2$`ExportValue` <- as.numeric(T2$`ExportValue`)Code
# Separate region and country
Region <- T1 %>%
filter(grepl('Million', `Data Series`)) %>%
rename("Region" = "ImportValue")
Country <- T1 %>%
filter(grepl('Thousand', `Data Series`)) %>%
rename("Country" = "ImportValue")
Import <- full_join(Region, Country, by = join_by(`Data Series`, `MonthYear`))
Import <- gather(Import , "Level", "ImportValue", -`Data Series`, -`MonthYear`)Code
# Separate region and country
Region <- T2 %>%
filter(grepl('Million', `Data Series`)) %>%
rename("Region" = "ExportValue")
Country <- T2 %>%
filter(grepl('Thousand', `Data Series`)) %>%
rename("Country" = "ExportValue")
Export <- full_join(Region, Country, by = join_by(`Data Series`, `MonthYear`))
Export <- gather(Export , "Level", "ExportValue", -`Data Series`, -`MonthYear`)Filter date and rename column
Import <- Import %>%
filter(`MonthYear`>= as.Date("2009-12-01")) %>%
rename(`Country` = `Data Series`)
Export <- Export %>%
filter(`MonthYear`>= as.Date("2009-12-01")) %>%
rename(`Country` = `Data Series`)Merge Import and Export into one table
data1 <- full_join(Import, Export, by = join_by(`Country`, `MonthYear`,`Level`))
data <- gather(data1 , "Type", "Value", -`Country`, -`MonthYear`,-`Level`)2.1 Table: Merchandise Imports/Export By Region/Market, Monthly
| Country | MonthYear | Level | ImportValue |
|---|---|---|---|
| America (Million Dollars) | 2022-12-01 | Region | 6901.5 |
| Asia (Million Dollars) | 2022-12-01 | Region | 33611.7 |
| Europe (Million Dollars) | 2022-12-01 | Region | 7541.8 |
| Oceania (Million Dollars) | 2022-12-01 | Region | 1399.9 |
| Africa (Million Dollars) | 2022-12-01 | Region | 414.9 |
| European Union (Million Dollars) | 2022-12-01 | Region | 5058.8 |
| America (Million Dollars) | 2022-11-01 | Region | 7529.4 |
| Asia (Million Dollars) | 2022-11-01 | Region | 34733.7 |
| Europe (Million Dollars) | 2022-11-01 | Region | 7242.8 |
| Oceania (Million Dollars) | 2022-11-01 | Region | 664.4 |
| Africa (Million Dollars) | 2022-11-01 | Region | 483.6 |
| European Union (Million Dollars) | 2022-11-01 | Region | 4961.4 |
| America (Million Dollars) | 2022-10-01 | Region | 7666.4 |
| Asia (Million Dollars) | 2022-10-01 | Region | 36120.9 |
| Europe (Million Dollars) | 2022-10-01 | Region | 7475.9 |
| Country | MonthYear | Level | ExportValue |
|---|---|---|---|
| America (Million Dollars) | 2022-12-01 | Region | 6217.5 |
| Asia (Million Dollars) | 2022-12-01 | Region | 39734.8 |
| Europe (Million Dollars) | 2022-12-01 | Region | 4924.4 |
| Oceania (Million Dollars) | 2022-12-01 | Region | 3034.8 |
| Africa (Million Dollars) | 2022-12-01 | Region | 1088.6 |
| European Union (Million Dollars) | 2022-12-01 | Region | 4137.1 |
| America (Million Dollars) | 2022-11-01 | Region | 6394.2 |
| Asia (Million Dollars) | 2022-11-01 | Region | 37973.2 |
| Europe (Million Dollars) | 2022-11-01 | Region | 5025.2 |
| Oceania (Million Dollars) | 2022-11-01 | Region | 3243.1 |
| Africa (Million Dollars) | 2022-11-01 | Region | 1527.0 |
| European Union (Million Dollars) | 2022-11-01 | Region | 4243.4 |
| America (Million Dollars) | 2022-10-01 | Region | 6653.9 |
| Asia (Million Dollars) | 2022-10-01 | Region | 40500.8 |
| Europe (Million Dollars) | 2022-10-01 | Region | 5121.5 |
2.2 Scatter plot Dashboard
Code
library(plotly)
Q1 <- data1 %>%
subset(ImportValue <= 5000000 & ExportValue <= 5000000)
Q2 <- data1 %>%
subset(ImportValue > 5000000 & ExportValue <= 5000000)
Q3 <- data1 %>%
subset(ImportValue > 5000000 & ExportValue > 5000000)
Q4 <- data1 %>%
subset(ImportValue <= 5000000 & ExportValue > 5000000)
Q4 %>%
plot_ly(
x = ~`ImportValue`,
y = ~`ExportValue`,
color = ~`Country`,
frame = ~year(`MonthYear`),
text= ~paste("Country:",`Country`,
"\nImport Value:", `ImportValue`,
"\nExport Value:", `ExportValue`),
hoverinfo = "text",
type = 'scatter',
mode = 'markers'
) %>%
layout(title = list(text="Low Import - High Export"),
hoverlabel = list(align = "left"),
legend = list(orientation = "h", y = 1, x = 0),
showlegend = FALSE,
xaxis = list(title="Import Value", range = list(0, 5000000)),
yaxis = list(title="Export Value", range = list(5000000, 10000000))
) %>% animation_opts(
1000, easing = "linear", redraw = FALSE
)
Q3 %>%
plot_ly(
x = ~`ImportValue`,
y = ~`ExportValue`,
color = ~`Country`,
frame = ~year(`MonthYear`),
text= ~paste("Country:",`Country`,
"\nImport Value:", `ImportValue`,
"\nExport Value:", `ExportValue`),
hoverinfo = "text",
type = 'scatter',
mode = 'markers'
) %>%
layout(title = list(text="High Import - High Export"),
hoverlabel = list(align = "left"),
legend = list(orientation = "h", y = 1, x = 0),
showlegend = FALSE,
xaxis = list(title="Import Value", range = list(5000000, 10000000)),
yaxis = list(title="Export Value", range = list(5000000, 10000000))
) %>% animation_opts(
1000, easing = "linear", redraw = FALSE
)
Q1 %>%
plot_ly(
x = ~`ImportValue`,
y = ~`ExportValue`,
color = ~`Country`,
frame = ~year(`MonthYear`),
text= ~paste("Country:",`Country`,
"\nImport Value:", `ImportValue`,
"\nExport Value:", `ExportValue`),
hoverinfo = "text",
type = 'scatter',
mode = 'markers'
) %>%
layout(title = list(text="Low Import - Low Export"),
hoverlabel = list(align = "left"),
legend = list(orientation = "h", y = 1, x = 0),
showlegend = FALSE,
xaxis = list(title="Import Value", range = list(0, 5000000)),
yaxis = list(title="Export Value", range = list(0, 5000000))
) %>% animation_opts(
1000, easing = "linear", redraw = FALSE
)
Q2 %>%
plot_ly(
x = ~`ImportValue`,
y = ~`ExportValue`,
color = ~`Country`,
frame = ~year(`MonthYear`),
text= ~paste("Country:",`Country`,
"\nImport Value:", `ImportValue`,
"\nExport Value:", `ExportValue`),
hoverinfo = "text",
type = 'scatter',
mode = 'markers'
) %>%
layout(title = list(text="High Import - Low Export"),
hoverlabel = list(align = "left"),
legend = list(orientation = "h", y = 1, x = 0),
showlegend = FALSE,
xaxis = list(title="Import Value", range = list(5000000, 10000000)),
yaxis = list(title="Export Value", range = list(0, 5000000))
) %>% animation_opts(
1000, easing = "linear", redraw = FALSE
)# Prepare data for plotting
scatter <- data1 %>%
filter(Level=="Country")
# Building interactive filters
d <- highlight_key(scatter)
filter_tools <- htmltools::div(
filter_slider(id = "period",
label = "Select period",
sharedData = d,
column = ~MonthYear,
dragRange = TRUE,
step = 30,
animate = TRUE,
width = "100%",
)
)
# plotting interactive scatter plot using plotly
p <- plot_ly(data=d,
x = ~`ImportValue`,
y = ~`ExportValue`,
type= "scatter",
mode= "markers",
color= ~`Country`,
symbol = ~`Level`,
colors = "Accent",
marker= list(size=5, opacity = 0.5,
line=list(width=0.2, color="black")),
text= ~paste("Country:",`Country`,
"\nImport Value:", `ImportValue`,
"\nExport Value:", `ExportValue`))
p <- p %>%
layout(title = list(text="<b>Xxxxxxxxxxxxxxxx</b>"),
hoverlabel = list(align = "left"),
legend = list(orientation = "h", y = 1.5, x = 0),
showlegend = FALSE,
xaxis = list(title="Import Value", range = list(0, 10000000)),
yaxis = list(title="Export Value", range = list(0, 10000000))
)
p <- p %>%
animation_opts(
1000, easing = "elastic", redraw = FALSE
)
gg <- highlight(p, "plotly_selected")
crosstalk::bscols(filter_tools,gg, widths = c(10, 12))2.3 Interactive Dashboard
# Building interactive filters
scatter <- data1 %>%
filter(Level=="Country")
d <- highlight_key(data)
filter_tools <- htmltools::div(
filter_select(id = "country",
label = "Select Country",
sharedData = d,
group = ~Country),
filter_checkbox(id = "variable",
label = "Select variable",
sharedData = d,
group = ~Type,
inline = TRUE),
filter_slider(id = "period",
label = "Select period",
sharedData = d,
column = ~MonthYear,
width = "100%"))
bscols(
d3scatter(data = scatter,
x = ~`ImportValue`,
y = ~`ExportValue`,
color = ~`Country`,
# point_size = 50,
# point_opacity = 0.5,
# colors = "#A94175",
width = "100%",
height = 500
# fixed = FALSE,
# xlim = c(0, 100000),
# ylim = c(0, 200000),
# xlab = "Import",
# ylab = "Export",
# axes_font_size = "100%",
# lab = ~`Country`
)
)# # plotting interactive scatter plot using plotly
# p <- plot_ly(data=d,
# type= "scatter",
# mode= "markers",
# x= ~lease_commence_date,
# y= ~resale_price,
# color= ~storey,
# colors= "Accent",
# marker= list(size=5, opacity = 0.5,
# line=list(width=0.2, color="black")),
# text= ~paste("Town:",town,
# "\nYear:",lease_commence_date,
# "\nLocation:",address,
# "\nType:",flat_type,
# "\nResale Price:",prettyNum(resale_price,big.mark=","),
# "\nStorey:",storey_range,
# "\nNearest MRT:",nearest_mrt," ~",nearest_distance_to_mrt,"km"
# )) %>%
# layout(title = list(text="<b>Xxxxxxxxxxxxxxxx</b>"),
# hoverlabel = list(align = "left"),
# legend = list(orientation = "h", y = 1, x = 0),
# xaxis = list(title="Lease Commencement Year"),
# yaxis = list(title="Resale Price (S$)"))
# gg <- highlight(p, "plotly_selected")
# Using crosstalk bscols to put all 3 elements (filter, scatter plot, datatable) together.
crosstalk::bscols(filter_tools,DT::datatable(d, class= "display",
filter=list(position="top", clear=FALSE),
options=list(pageLength = 10,scrollY = TRUE,
iDisplayLength = 25),
),
widths = c(3,12),
annotations = list(caption = "Data from Department of Statistics, Singapore (DOS)"))# crosstalk::bscols(filter_tools,gg,DT::datatable(d, class= "display",
# filter=list(position="top", clear=FALSE),
# options=list(pageLength = 10,scrollY = TRUE,
# iDisplayLength = 25),
# ),
# widths = c(3,9,12),
# annotations = list(caption = "Data from Data.gov.sg"))2.4 Cycle Plot
Step 1: Deriving month and year fields
#
# Import$month <- month(Import$`MonthYear`)
# Import$year <- year(Import$`MonthYear`)Step 2: Extracting the target country
# Australia <- Import %>%
# filter(`Country`== " Australia (Thousand Dollars)")Step 3: Computing year average arrivals by month
# hline.data <- Australia %>%
# group_by(month) %>%
# summarise(avgvalue = mean(`Value`))Step 4: Plotting the cycle plot ::: {#1 layout=“[1]”}
# ggplot() +
# geom_line(data=America,
# aes(x=year,
# y=`ImportValue`,
# group=month),
# colour="black") +
# geom_hline(aes(yintercept=avgvalue),
# data=hline.data,
# linetype=6,
# colour="red",
# linewidth=0.5) +
# facet_grid(~month) +
# labs(axis.text.x = element_blank(),
# title = "xxxxxxxxxxxxxxxxxxxxxxxxx") +
# xlab("") +
# ylab("Import Value") +
# theme(plot.title = element_text(size=22),
# axis.text.x = element_text(size = 10, angle = 90),
# axis.text.y = element_text(size = 10),
# strip.text = element_text(size = 10))Using callouts is an effective way to highlight content that your reader give special consideration or attention.